home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
postnt.zip
/
POSTNT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-02-25
|
8KB
|
384 lines
program POSTNT;
{ Date: 02-25-90 }
(*********************************************************************)
(* POSTNT was written as an exercise. The intent was to produce *)
(* a program which could print US Postal Service POSTNET barcodes *)
(* (those lines on lower right corner of some of the letters *)
(* you get in the mail) which could be used for demonstration *)
(* and information purposes. As it turned out, the barcodes *)
(* actually are 'readable' on a barcode sorter. *)
(* *)
(* *)
(* This program was written by Dave Barrett, CS 76314,1004 *)
(* This program is put in the public domain with the following *)
(* conditions: *)
(* *)
(* 1) This portion of the documentation must remain with the source. *)
(* 2) If you make any improvements to the program please post them *)
(* so others can enjoy them. *)
(* 3) This program must be distributed without charge whether used *)
(* alone or included as part of another program. *)
(* 4) Please include the accompanying file POSTNT.DOC along with *)
(* this file *)
(*********************************************************************)
uses dos,crt,printer;
type
NumberSet = set of char;
var
CheckDigit,
ZIPString : string[200];
Afield,
Bfield : string [10];
Numbers : NumberSet;
CheckNumber,
result : integer;
ZIPCodeIsValid : boolean;
procedure PrintFullBar;
begin
Write(Lst,char(255));
Write(Lst,char(255));
Write(Lst,char(255));
Write(Lst,char(255));
end;
procedure PrintFullSpace;
begin
Write(Lst,char(0));
Write(Lst,char(0));
Write(Lst,char(0));
Write(Lst,char(0));
Write(Lst,char(0));
Write(Lst,char(0));
Write(Lst,char(0));
Write(Lst,char(0));
end;
procedure PrintPartSpace;
begin
Write(Lst,char(0));
Write(Lst,char(0));
Write(Lst,char(0));
Write(Lst,char(0));
Write(Lst,char(0));
Write(Lst,char(0));
Write(Lst,char(0));
end;
procedure PrintHalfBar;
begin
Write(Lst,char(15));
Write(Lst,char(15));
Write(Lst,char(15));
Write(Lst,char(15));
end;
procedure PrintFrameBar;
begin
PrintFullBar;
PrintFullSpace;
end;
procedure Print0;
begin
PrintFullBar;
PrintFullSpace;
PrintFullBar;
PrintPartSpace;
PrintHalfBar;
PrintFullSpace;
PrintHalfBar;
PrintPartSpace;
PrintHalfBar;
PrintFullSpace;
end;
procedure Print1;
begin
PrintHalfBar;
PrintFullSpace;
PrintHalfBar;
PrintPartSpace;
PrintHalfBar;
PrintFullSpace;
PrintFullBar;
PrintPartSpace;
PrintFullBar;
PrintFullSpace;
end;
procedure Print2;
begin
PrintHalfBar;
PrintFullSpace;
PrintHalfBar;
PrintPartSpace;
PrintFullBar;
PrintFullSpace;
PrintHalfBar;
PrintPartSpace;
PrintFullBar;
PrintFullSpace;
end;
procedure Print3;
begin
PrintHalfBar;
PrintFullSpace;
PrintHalfBar;
PrintPartSpace;
PrintFullBar;
PrintFullSpace;
PrintFullBar;
PrintPartSpace;
PrintHalfBar;
PrintFullSpace;
end;
procedure Print4;
begin
PrintHalfBar;
PrintFullSpace;
PrintFullBar;
PrintPartSpace;
PrintHalfBar;
PrintFullSpace;
PrintHalfBar;
PrintPartSpace;
PrintFullBar;
PrintFullSpace;
end;
procedure Print5;
begin
PrintHalfBar;
PrintFullSpace;
PrintFullBar;
PrintPartSpace;
PrintHalfBar;
PrintFullSpace;
PrintFullBar;
PrintPartSpace;
PrintHalfBar;
PrintFullSpace;
end;
procedure Print6;
begin
PrintHalfBar;
PrintFullSpace;
PrintFullBar;
PrintPartSpace;
PrintFullBar;
PrintFullSpace;
PrintHalfBar;
PrintPartSpace;
PrintHalfBar;
PrintFullSpace;
end;
procedure Print7;
begin
PrintFullBar;
PrintFullSpace;
PrintHalfBar;
PrintPartSpace;
PrintHalfBar;
PrintFullSpace;
PrintHalfBar;
PrintPartSpace;
PrintFullBar;
PrintFullSpace;
end;
procedure Print8;
begin
PrintFullBar;
PrintFullSpace;
PrintHalfBar;
PrintPartSpace;
PrintHalfBar;
PrintFullSpace;
PrintFullBar;
PrintPartSpace;
PrintHalfBar;
PrintFullSpace;
end;
procedure Print9;
begin
PrintFullBar; { 4 }
PrintFullSpace; { 8 }
PrintHalfBar; { 4 }
PrintPartSpace; { 7 }
PrintFullBar; { 4 }
PrintFullSpace; { 8 }
PrintHalfBar; { 4 }
PrintPartSpace; { 7 }
PrintHalfBar; { 4 }
PrintFullSpace; { 8 }
end;
procedure PrintBarCode(s:integer);
var
i : integer;
begin
PrintFrameBar;
i:=1;
while i <= Length(ZIPString) do
begin
case ZIPString[i] of
'0':Print0;
'1':Print1;
'2':Print2;
'3':Print3;
'4':Print4;
'5':Print5;
'6':Print6;
'7':Print7;
'8':Print8;
'9':Print9;
end;
i:=i+1;
end;
PrintFrameBar;
if s=1 then
else
Writeln(Lst);
end;
procedure DetermineCheckDigit;
var
zip_digit,
zip_total,
i : integer;
begin
zip_total:=0;
for i:=1 to Length(ZIPString) do
begin
Val(ZIPString[i],zip_digit,result);
zip_total:=zip_total+zip_digit;
end;
CheckNumber:=10 - (zip_total MOD 10);
Str(CheckNumber:1,CheckDigit);
ZIPString:=ZIPString+CheckDigit;
end;
procedure VerifyDigits;
var
i : integer;
begin
Numbers:=['0','1','2','3','4','5','6','7','8','9'];
ZIPCodeIsValid:=true;
if ((Copy(ZIPString,1,1)='A') OR (Copy(ZIPString,1,1)='a'))
AND ((Copy(ZIPString,2,1)='B') OR (Copy(ZIPString,2,1)='b'))
AND (Length(ZIPString)=13) then
ZIPString:=Copy(ZIPString,3,11);
if (Length(ZIPString)=5) then
begin
for i:=1 to 5 do
if ZIPString[i] in Numbers then
begin end
else
ZIPCodeIsValid:=false;
end
else
if (Length(ZIPString)=9) then
begin
for i:=1 to 9 do
if ZIPString[i] in Numbers then
begin end
else
ZIPCodeIsValid:=false;
end
else
if (Length(ZIPString)=10) AND (Pos('-',ZIPString)=6) then
begin
Delete(ZIPString,6,1);
for i:=1 to 9 do
if ZIPString[i] in Numbers then
begin end
else
ZIPCodeIsValid:=false;
end
else
if (Length(ZIPString)=11) then
begin
for i:=1 to 11 do
if ZIPString[i] in Numbers then
begin end
else
ZIPCodeIsValid:=false;
end
else
ZIPCodeIsValid:=false;
end;
procedure Initialization;
begin
if ParamCount = 1 then
begin
ZIPString:=ParamStr(1);
VerifyDigits;
end
else
ZIPCodeIsValid:=false;
end;
begin
ZIPString:='';
Initialization;
if ZIPCodeIsValid then
begin
if Length(ZIPString)=11 then
begin
Afield:=Copy(ZIPString,1,5);
Bfield:=Copy(ZIPString,6,6);
ZIPString:=Afield;
DetermineCheckDigit;
Write(Lst,char(27),'Z',char(116),char(1));
PrintBarCode(1); { no CR/LF }
Write(Lst,' ');
ZIPString:=Bfield;
DetermineCheckDigit;
Write(Lst,char(27),'Z',char(174),char(1));
PrintBarCode(0); { CR/LF ok }
end
else
begin
DetermineCheckDigit;
if Length(ZIPSTring) = 6 then
Write(Lst,char(27),'Z',char(116),char(1))
else
Write(Lst,char(27),'Z',char(92),char(2));
PrintBarCode(0); { CR/LF ok }
end;
end
else
begin
TextColor(LightGray);
TextBackground(Black);
ClrScr;
Writeln;
Writeln('Usage is ....');
Writeln;
Writeln('POSTNT zipcode');
Writeln;
Writeln('Where zipcode is a 5, 9, or 10 character ZIP in the form');
Writeln(' 99999 or 999999999 or 99999-9999');
Writeln('or an AB field 11 character ZIP in the form');
Writeln(' AB99999999999');
Writeln('Note that in the AB field example above the use of AB');
Writeln('preceeding the 11 digit ZIP is required!');
Writeln;
end;
end.